home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 22
/
Cream of the Crop 22.iso
/
program
/
ctlib100.zip
/
INSTALL.LZH
/
BTREES2.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-10-12
|
4KB
|
138 lines
{**************************************************************************}
{* BitSoft Development, L.L.C. *}
{* Copyright (C) 1995, 1996 BitSoft Development, L.L.C. *}
{* All rights reserved. *}
{* Containers Library demo *}
{**************************************************************************}
program BTrees2;
{$X+}
{ Sample program for opening a B tree. }
uses Objects, Containr, ctBTrees,
{$ifdef Windows}
WinCtr;
{$else}
Crt;
{$endif}
type
PContact = ^TContact;
TContact = record
FirstName : string[15];
LastName : string[20];
Phone : string[18];
Company : string [25];
end; { TContact }
type
PContactList = ^TContactList;
TContactList = object(TBTree)
function KeyOf(Item : Pointer) : Pointer; virtual;
end; { TContactList }
function TContactList.KeyOf(Item : Pointer) : Pointer;
begin
KeyOf := @PContact(Item)^.LastName;
end;
procedure SetContactValues(ALastName, AFirstName, APhone,
ACompany : string; var ContactRec : TContact);
begin
with ContactRec do
begin
FirstName := AFirstName;
LastName := ALastName;
Phone := APhone;
Company := ACompany;
end; { with }
end;
procedure DisplayContacts(ContactList : PGraph);
procedure PrintInfo (Item : Pointer); far;
begin
with PContact(Item)^ do
writeln(LastName, '':15 - Length(LastName),
FirstName, '':15 - Length(FirstName),
Phone, '':20 - Length(Phone),
Company, '':20 - Length(Company));
end;
begin
ContactList^.ForEach(@PrintInfo);
end;
procedure DisplayFirst(ContactList : PGraph);
var
Item : Pointer;
begin
Item := ContactList^.First;
Writeln('First item:');
with PContact(Item)^ do
writeln(LastName, '':15 - Length(LastName),
FirstName, '':15 - Length(FirstName),
Phone, '':20 - Length(Phone),
Company, '':20 - Length(Company));
ContactList^.DoneItem(Item); { not required }
end;
procedure DisplayLast(ContactList : PGraph);
var
Item : Pointer;
begin
Item := ContactList^.Last;
Writeln('Last item:');
with PContact(Item)^ do
writeln(LastName, '':15 - Length(LastName),
FirstName, '':15 - Length(FirstName),
Phone, '':20 - Length(Phone),
Company, '':20 - Length(Company));
ContactList^.DoneItem(Item); { not required }
end;
procedure FindLastName(ContactList : PGraph; LastName : string);
var
Item : Pointer;
begin
Item := ContactList^.KeyFirst(@LastName);
Writeln('Item found with last name ''', LastName, ''':');
with PContact(Item)^ do
writeln(LastName, '':15 - Length(LastName),
FirstName, '':15 - Length(FirstName),
Phone, '':20 - Length(Phone),
Company, '':20 - Length(Company));
ContactList^.DoneItem(Item); { not required }
end;
var
ContactList : PContactList;
Contact : TContact;
Stream : PBufStream;
begin
ClrScr;
{ Open the stream }
Stream := New(PBufStream, Init('btrees.dat', stOpen, 1024));
{ Open the B tree }
ContactList := New(PContactList, Open(Stream, 5));
DisplayContacts(ContactList);
Writeln;
DisplayFirst(ContactList);
Writeln;
DisplayLast(ContactList);
Writeln;
FindLastName(ContactList, 'Wagner');
{ Dispose of the B tree }
Dispose(ContactList, Done);
{ Dispose of the stream }
Dispose(Stream, Done);
end.